home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
p063b9s.zip
/
UNIT
/
BTREE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-04-20
|
10KB
|
346 lines
UNIT BTree;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ BTree routines for Opus 1.73a Last changed: 20.04.96 SA ║}
{║ ║}
{║ (C) Copyright 1989-93 by ║}
{║ Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager ║}
{║ ,Birger Kristensen ║}
{║ This source may not be given to anybody, without the written permission ║}
{║ from The Portal Team. ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}
INTERFACE
USES Use32, PoPTypes, Dos;
TYPE
FindType = (Previous,Match,Next);
CompProc = function(var ALine,Desire; L:char):integer;
TA=RECORD
Fill : BYTE;
Zone,
Net,
Node,
Point : INTEGER;
END;
CtlBlk = record
BlkSize : word;
Root,
HiBlk,
LoLeaf,
HiLeaf,
Free : longint;
Lvls,
Parity : word;
end;
IdxRefBlk = record
IdxOfs,
IdxLen : word;
IdxData,
IdxPtr : longint;
end;
LeafRefBlk = record
KeyOfs,
KeyLen : word;
KeyVal : longint;
end;
INodeBlk = record
First,
BLink,
FLink : LongInt;
Cnt : Integer;
StrOf : Word;
IdxRef : array[0..49] of IdxRefBlk;
end;
LNodeBlk = record
First,
BLink,
FLink : longint;
Cnt : integer;
StrOf : word;
LeafRef : array[0..49] of LeafRefBlk;
end;
RealDatRec = record
Zone,
Net,
Node,
Point : integer;
CallCost,
MsgFee,
NodeFlags : word;
ModemType,
PhoneLen,
PassWordLen,
BNameLen,
SNameLen,
CNameLen,
PackLen,
Baud : byte;
Pack : array[1..160] of char;
end;
DatRec = record
Zone,
Net,
Node,
Point : integer;
CallCost,
MsgFee,
NodeFlags : word;
ModemType,
Password : string[9];
Phone,
BName,
CName,
SName : string[39];
BaudRate,
RecSize : byte;
end;
KeyStr=S30;
FUNCTION FindKey(CONST FName: PathStr; VAR RecNum: LongInt; CONST Desired: KeyStr): Boolean;
FUNCTION NextKey(CONST FName: PathStr; VAR RecNum: LongInt; CONST Desired: KeyStr): Boolean;
FUNCTION PrevKey(CONST FName: PathStr; VAR RecNum: LongInt; CONST Desired: KeyStr): Boolean;
IMPLEMENTATION
USES NetFile;
function CompName(var S,D; L:char):integer; far;
var
Key,Des : S160;
Len : byte absolute L;
begin
Key[0]:=L;
Des[0]:=L;
Move(S,Key[1],Len);
Move(D,Des[1],Len);
if Key>Des then CompName:=1 else
if Key<Des then CompName:=-1 else CompName:=0;
end;
{
function CompAddress(var S,D; L:char):integer; far;
var
Key : TA absolute S;
Des : TA absolute D;
I : byte;
K : integer;
begin
IF l=#6 THEN Des.Point:=0;
I:=0;
repeat
Inc(I);
case I of
1 : K:=Key.Zone-Des.Zone;
2 : K:=Key.Net-Des.Net;
3 : K:=Key.Node-Des.Node;
4 : begin
if L=#6 then Key.Point:=0;
K:=Key.Point-Des.Point;
end;
end;
until (I=4) or (K<>0);
CompAddress:=K;
end;
}
FUNCTION CompAddress(VAR s, d; l:CHAR): Integer;
TYPE
AT = RECORD
Len : Byte;
zone,net,node,point: Integer;
END;
VAR
k : Integer;
BEGIN
k:=AT(s).Zone-AT(d).Zone;
IF k=0 THEN
BEGIN
k:=AT(s).Net-AT(d).Net;
IF k=0 THEN
BEGIN
k:=AT(s).Node-AT(d).Node;
IF k=0 THEN
BEGIN
IF BYTE(s)=6 THEN AT(s).Point:=0;
IF BYTE(d)=6 THEN AT(d).Point:=0;
k:=AT(s).Point-AT(d).Point;
END;
END;
END;
CompAddress:=k;
END;
function Find(var F: TNetFile; Desired:S160; Compare:CompProc; var KeyL:byte; FT:FindType):longint;
var
Buf : array[0..511] of byte;
Ctl : CtlBlk absolute Buf;
INode : INodeBlk absolute Buf;
LNode : LNodeBlk absolute Buf;
SaveCtl : CtlBlk;
count : byte;
currentblocknumber : longint;
difference : integer;
s : string;
begin
f.Seek(0);
f.BlockRead(Buf,SizeOf(Buf));
Move(Buf,SaveCtl,SizeOf(Ctl));
f.Seek(SaveCtl.BlkSize*Ctl.Root);
f.BlockRead(Buf,SizeOf(Buf));
currentblocknumber := -1;
count := 0;
While INode.First <> -1 do { S¢g i indexblokke, indtil leafnode er fundet }
begin
difference := -1;
While (count < INode.Cnt) and (difference < 0) do
begin
FillChar(S,SizeOf(S),#0);
Move(Buf[INode.IdxRef[count].IdxOfs],S[1],INode.IdxRef[count].IdxLen);
BYTE(s[0]):=INode.IdxRef[count].IdxLen;
difference := Compare(S,Desired,Chr(inode.IdxRef[count].IdxLen));
if (difference = 0) AND (FT = Match) then { Her afslutter s¢gning, hvis Match }
begin
Find:=INode.IdxRef[count].IdxData;
KeyL:=INode.IdxRef[count].IdxLen;
exit;
end;
IF difference < 0 THEN INC (Count); { move to right (i.e. Increment count) until difference >= 0 }
end;
IF difference = 0 then currentblocknumber := inode.IdxRef[Count].IdxPtr
else IF Count = 0 THEN currentblocknumber := inode.First
ELSE currentblocknumber := inode.IdxRef[Count-1].IdxPtr;
f.Seek(SaveCtl.BlkSize*currentblocknumber);
f.BlockRead(Buf,SizeOf(Buf));
count := 0;
end;
difference := -1;
count := 0;
while (count < LNode.Cnt) and (difference < 0) do { Vi har nu fundet leafblokken }
begin
FillChar(S,SizeOf(S),#0);
Move(Buf[lNode.leafRef[count].keyOfs],S[1],lNode.leafRef[count].keyLen);
BYTE(s[0]):=lNode.leafRef[count].keyLen;
difference := Compare(S,Desired,Chr(lnode.leafRef[count].keyLen));
if difference = 0 then
begin
case FT of
Previous : begin
if count > 0 then
begin
find:=lNode.leafRef[count-1].keyVal;
KeyL:=lNode.leafRef[count-1].keyLen;
end
else
begin
if Lnode.blink <> 0 then
begin
f.Seek(SaveCtl.BlkSize*Lnode.blink);
f.BlockRead(Buf,SizeOf(Buf));
find:=lnode.LeafRef[lnode.cnt-1].KeyVal;
KeyL:=lnode.LeafRef[lnode.cnt-1].KeyLen;
end
else
begin
find:=lnode.LeafRef[0].KeyVal;
KeyL:=lnode.LeafRef[0].KeyLen;
end;
end;
end;
Match : begin
find:=lnode.LeafRef[count].KeyVal;
KeyL:=lnode.LeafRef[count].KeyLen;
end;
Next : begin
if count < lnode.cnt-1 then
begin
find:=lnode.LeafRef[count+1].KeyVal;
KeyL:=lnode.LeafRef[count+1].KeyLen;
end
else
begin
if Lnode.flink <> 0 then
begin
f.Seek(SaveCtl.BlkSize*Lnode.flink);
f.BlockRead(Buf,SizeOf(Buf));
find:=lNode.leafRef[0].keyval;
KeyL:=lNode.leafRef[0].keyLen;
end
else
begin
find:=lnode.LeafRef[lnode.cnt-1].KeyVal;
KeyL:=lnode.LeafRef[lnode.cnt-1].KeyLen;
end;
end;
end;
end;
end;
IF difference < 0 THEN INC (Count); { move to right (i.e. Increment count) until difference >= 0 }
IF (difference>0) OR (Count=LNode.Cnt) THEN
BEGIN
Count:=LNode.Cnt;
Find:=-1;
END;
end;
end;
FUNCTION FindKey(CONST FName: PathStr; VAR RecNum: LongInt; CONST Desired: KeyStr): Boolean;
VAR
Idx : TNetFile;
Kl : BYTE;
BEGIN
FindKey:=FALSE;
IF Idx.Open(FName,1,FALSE) THEN
BEGIN
RecNum:=Find(Idx,Desired,CompAddress,Kl,Match);
Idx.Close;
FindKey:=(RecNum<>-1);
END;
END;
FUNCTION NextKey(CONST FName: PathStr; VAR RecNum: LongInt; CONST Desired: KeyStr): Boolean;
VAR
Idx : TNetFile;
Kl : BYTE;
BEGIN
NextKey:=FALSE;
IF Idx.Open(FName,1,FALSE) THEN
BEGIN
RecNum:=Find(Idx,Desired,CompAddress,Kl,Next);
{ NextKey:=TRUE;}
NextKey:=(RecNum<>-1);
Idx.Close;
END;
END;
FUNCTION PrevKey(CONST FName: PathStr; VAR RecNum: LongInt; CONST Desired: KeyStr): Boolean;
VAR
Idx : TNetFile;
Kl : BYTE;
BEGIN
PrevKey:=FALSE;
IF Idx.Open(FName,1,FALSE) THEN
BEGIN
{ PrevKey:=TRUE;}
RecNum:=Find(Idx,Desired,CompAddress,Kl,Previous);
PrevKey:=(RecNum<>-1);
Idx.Close;
END;
END;
END.